home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Shareware Grab Bag
/
Shareware Grab Bag.iso
/
007
/
tttool30.arc
/
FASTWRIT.TTT
< prev
next >
Wrap
Text File
|
1986-09-28
|
9KB
|
291 lines
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
{ }
{ T E C H N O J O C K S T U R B O T O O L K I T }
{ }
{ Module : Fastwrit.TTT }
{ }
{ Version : 3.0 , October 1, 1986 }
{ }
{ Purpose : All these procedures rely upon }
{ Fastwrite which is an inline procedure }
{ that enables very rapid screen updates. }
{ The procedures are highly machine }
{ dependent and will only work on IBM and }
{ true compatibles. }
{ Requirements : Decl.TTT }
{ }
{ }
{ Proc FastWrite(X,Y,attrib:byte;str:string80); used internally }
{ Box(X1,Y1,X2,Y2,F,B,boxtype:integer); }
{ Horizline(X1,X2,Y,F,B,linetype:integer); }
{ VertLine(X,Y1,Y2,F,B,linetype:integer); }
{ ClearText(X1,Y1,X2,Y2,F,B:integer); }
{ WriteAT(X,Y,F,B:integer;St:string80); }
{ WriteCenter(LineNo,F,B:integer:St:string80); }
{ WriteBetween(X1,X2,Y,F,B:integer;St:string80); }
{ WriteVert(X,Y,F,B:integer;St:string80); }
{ TempMessage(Y,F,B:integer;St:string80); }
{ FindCursor(X,Y,ScanTop,ScanBot : integer); }
{ PosCursor(X,Y:integer); }
{ SizeCursor(ScanTop,ScanBot:integer); }
{ OnCursor; }
{ OffCursor; }
{ VideoOff; }
{ VideoOn; }
{ }
{ Func Attr(Fore,Back:integer):byte; used internally }
{ }
{ Bob Ainsbury }
{ Technojock }
{ Houston }
{ (713) 293-2760 }
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
Function Attr(F,B:integer):byte;
begin
F := F mod 16;
B := B mod 16;
attr := (B shl 4) or F;
end;
Procedure Fastwrite(col,row,attrib:byte;Str:string80);
var Strptr : ^string80;
begin
Strptr := ptr(seg(str),ofs(str));
inline
($1E/$1E/$8A/$86/ROW/$48/$B3/$50/$F6/$E3/$2B/$DB/$8A/$9E/col/$4B/
$03/$C3/$03/$C0/$8B/$F8/$8A/$BE/attrib/$C4/$B6/strptr/
$2B/$C9/$26/$8A/$0C/$2B/$C0/$8E/$D8/$A0/$49/$04/
$1F/$20/$C9/$74/$34/$2C/$07/$74/$21/$BA/$00/$B8/$8E/$DA/$BA/$DA/$03/
$46/$26/$8A/$1C/$EC/$A8/$01/$75/$FB/$FA/$EC/$A8/$01/$74/$FB/$89/$1D/
$47/$47/$E2/$EB/$2A/$C0/$74/$0F/$BA/$00/$B0/$8E/$DA/$46/$26/$8A/$1C/
$89/$1D/$47/$47/$E2/$F6/$1F);
end; {proc fastwrite}
Procedure Box(X1,Y1,X2,Y2,F,B,boxtype:integer);
var
I:integer;
corner1,corner2,corner3,corner4,
horizline,
vertline : char;
attrib : byte;
begin
case boxtype of
0:begin
corner1:=' ';
corner2:=' ';
corner3:=' ';
corner4:=' ';
horizline:=' ';
vertline:=' ';
end;
2:begin
corner1:='╔';
corner2:='╗';
corner3:='╚';
corner4:='╝';
horizline:='═';
vertline:='║';
end;
3:begin
corner1:='╓';
corner2:='╖';
corner3:='╙';
corner4:='╜';
horizline:='─';
vertline:='║';
end;
4:begin
corner1:='╒';
corner2:='╕';
corner3:='╘';
corner4:='╛';
horizline:='═';
vertline:='│';
end;
else
corner1:='┌';
corner2:='┐';
corner3:='└';
corner4:='┘';
horizline:='─';
vertline:='│';
end;{case}
attrib := attr(F,B);
FastWrite(X1,Y1,attrib,corner1);
For I := X1+1 to X2-1 do
FastWrite(I,Y1,attrib,horizline);
FastWrite(X2,Y1,attrib,corner2);
For I := Y1 + 1 to Y2 - 1 do
begin
FastWrite(X1,I,attrib,vertline);
FastWrite(X2,I,attrib,vertline);
end;
FastWrite(X1,Y2,attrib,corner3);
For I := X1+1 to X2-1 do
FastWrite(I,Y2,attrib,horizline);
FastWrite(X2,Y2,attrib,corner4);
end; {box}
procedure HorizLine(X1,X2,Y,F,B,lineType : byte);
var
I : integer;
Horizline : char;
attrib : byte;
begin
If (lineType in [2,4]) then
horizline := '═'
else
horizline := '─';
Attrib := attr(F,B);
If X2 > X1 then
For I := X1 to X2 do FastWrite(I,Y,attrib,Horizline)
else
For I := X2 to X1 do FastWrite(I,Y,attrib,Horizline);
end; {horizline}
Procedure VertLine(X,Y1,Y2,F,B,lineType : byte);
var
I : integer;
vertline : char;
attrib : byte;
begin
If (linetype in [2,4])then
vertline := '║'
else
vertline := '│';
Attrib := attr(F,B);
If Y2 > Y1 then
For I := Y1 to Y2 do Fastwrite(X,I,Attrib,Vertline)
else
For I := Y2 to Y1 do Fastwrite(X,I,Attrib,Vertline);
end; {vertline}
Procedure ClearText(x1,y1,x2,y2,F,B:integer);
var X,Y : integer;
attrib : byte;
begin
If x2 > 80 then x2 := 80;
Attrib := attr(F,B);
For Y := y1 to y2 do
For X := x1 to x2 do
Fastwrite(X,Y,attrib,' ');
end; {cleartext}
Procedure WriteAT(X,Y,F,B:integer;St:string80);
begin
Fastwrite(X,Y,attr(F,B),St);
end;
Procedure WriteCenter(LineNO,F,B:integer;St:string80);
begin
Fastwrite(40 - length(St) div 2,Lineno,attr(F,B),St);
end;
Procedure WriteBetween(X1,X2,Y,F,B:byte;St:string80);
var X : integer;
begin
If length(St) >= X2 - X1 + 1 then
WriteAT(X1,Y,F,B,St)
else
begin
x := X1 + (X2 - X1 + 1 - length(St)) div 2 ;
WriteAT(X,Y,F,B,St);
end;
end;
Procedure WriteVert(X,Y,F,B:integer;ST : string80);
var I : integer;Tempstr:string2;
begin
If length(St) > 26 - Y then delete(St,27 - Y,80);
For I := 1 to length(St) do
begin
Tempstr := st[I];
Fastwrite(X,Y-1+I,attr(F,B),St[I]);
end;
end;
Procedure FindCursor(var X,Y,ScanTop,ScanBot:integer);
var recpac : regpack;
begin
Recpack.Ax := $0F00; {get page in Bx}
Intr($10,recpack);
Recpack.Ax := $0300;
Intr($10,recpack);
With Recpack do
begin
X := lo(Dx) + 1;
Y := hi(Dx) + 1;
ScanTop := Hi(Cx) and $0F;
ScanBot := Lo(Cx) and $0F;
end;
end;
Procedure PosCursor(X,Y: integer);
var recpac : regpack;
begin
Recpack.Ax := $0F00; {get page in Bx}
Intr($10,recpack);
with recpack do
begin
Ax := $0200;
Dx := ((Y-1) shl 8) or ((X-1) and $00FF);
end;
Intr($10,recpack);
end;
Procedure SizeCursor(ScanTop,ScanBot:byte);
var recpack : regpack;
begin
with recpack do
begin
ax := 1 shl 8;
cx := Scantop shl 8 + Scanbot;
INTR($10,recpack);
end;
end;
Procedure OnCursor;
begin
If CRTmode = 7 then
SizeCursor(13,14)
else
SizeCursor(6,7);
end;
Procedure OffCursor;
begin
Sizecursor(14,0);
end;
procedure TempMessage(Y,F,B:integer;St:string80);
var CX,CY,CT,CB,I,locC:integer;
begin
For I := 1 to 80 do
begin
LocC := (I-1)*2 + (Y-1)*160;
Savedline[I].C := chr(mem[$b800:LocC]);
Savedline[I].A := mem[$b800:LocC+1];
end;
FindCursor(CX,CY,CT,CB);
WriteAT(1,Y,F,B,St);
Read(kbd,Ch);
while keypressed do read(kbd,Ch);
For I := 1 to 80 do
begin
LocC := (I-1)*2 + (Y-1)*160;
Mem[$B800:LocC] := ord(SavedLine[I].C);
Mem[$B800:LocC+1] := SavedLine[I].A;
end;
SizeCursor(CT,CB);
PosCursor(CX,CY);
end;
Procedure VideoOn;
begin
Port[CRTadapter+4] := (Videomode or $08)
end;
Procedure VideoOff;
begin
Port[CRTadapter+4] := (Videomode - $08);
end;